######################################################################
# Time-stamp: <05/08/11 18:13:16 ostolop>
######################################################################
package EP::Common::Data;

use strict;

use EP::Config;
use EP::Common;

use EP::Common::Error qw ( :try );
use EP::Common::DB;
use EP::Common::DBI::Dataset;

use EP::Common::General;

use EP::EPC::Core::Component;

use File::Spec;
use File::Path;
use File::Temp;

use PDL;
use PDL::IO::FlexRaw;

use DBI;

our @ISA = qw ( EP::EPC::Core::Component );

######################################################################
# returns a valid tmp-style filename in a given $folder
######################################################################
sub get_valid_filename {
  my ( $folder ) = @_;

  my $new_filename = mktemp ( File::Spec->catfile ( $EP::Config::h->{EPNG_USRDATA_PATH}, $folder, "data.$$.XXXXX" ) );
  my @new_filepath = File::Spec->splitpath ( $new_filename );

  return $new_filepath[2];
}

######################################################################
# Takes the submitted foldername, converts it to one with no funny 
# characters, tests if such a thing already exists (if
# yes, adds a .number to the end) and returns the new valid filename.
######################################################################
sub get_valid_foldername {
  my ( $folder, $foldername ) = @_;

  $foldername =~ tr/A-Za-z0-9/_/c;

  return $foldername if not -e File::Spec->catfile ( $EP::Config::h->{EPNG_USRDATA_PATH}, $folder, $foldername );

  my $i = 1;
  $i++ while -e File::Spec->catfile ( $EP::Config::h->{EPNG_USRDATA_PATH}, $folder, $foldername . "_$i" );

  return "$foldername\_$i";
}

######################################################################
# Delete all files on disk associated with a certain action (and its children)
######################################################################
sub delete_action {
  my ( $action ) = shift;

  1;
}

######################################################################
# Delete all files on disk associated with a certain root_dataset
######################################################################
sub delete_dataset {
  my ($root_dataset_id) = @_;

  my $sth_siblings = $EP::Config::h->{DBH}->prepare( "select * from ep_action_view where root_dataset = ?" );
  my $rc_siblings = $sth_siblings->execute( $root_dataset_id );
  warn ( $DBI::errstr ) and return 0 if !$rc_siblings;

  # remove all the actions associated with this dataset
  while ( my $sibling = $sth_siblings->fetchrow_hashref() ) {
    my $dataset = retrieve EP::Common::DBI::Dataset ( $sibling->{dst_dataset} );
    my $file = "$EP::Config::h->{EPNG_USRDATA_PATH}/" . $dataset->folder->location . "/" . $dataset->filename . "*";

    if ( -e glob ( "$file" ) ) {
      my $rc = unlink glob( "$file" );
      if ( $rc == 0 ) {
	warn "Failed to delete file: $file" if $rc == 0;
      } elsif ( DEBUG ) {
	warn "Successfully deleted $rc file(s) ($file)";
      }
    }
  }
}

sub delete_folder {
    my ($location) = @_;
    my $verbose = 0;
    $verbose = 1 if DEBUG;

    # delete the directory structure on disk
    select(STDERR);
    my $rc = rmtree ( "$EP::Config::h->{EPNG_USRDATA_PATH}/$location", $verbose );
    select(STDOUT);

    if ( not $rc ) {
	warn "No files where deleted\n";
    } elsif ( DEBUG ) {
	warn "Successfully deleted $rc files\n";
    }
}

sub create_folder {
    my ($location) = @_;

    # try to create the directory, if fail check if one exists already - on fail rollback
    my $rc = mkdir "$EP::Config::h->{EPNG_USRDATA_PATH}/$location";

    if ( not $rc ) {
	if ( -d "$EP::Config::h->{EPNG_USRDATA_PATH}/$location" ) {
	    if ( not -w "$EP::Config::h->{EPNG_USRDATA_PATH}/$location" ) {
		throw EP::Common::Error ( -value => FS_USER_DIR_NOT_WRITEABLE );
	    } else {
		# LOG: Couldn't create directory, using the existing one
		warn "Using existing directory $location";
	    }
	} else {
	    throw EP::Common::Error ( -value => FS_CREATE_USER_DIR_FAILURE );
	}
    }
    return;
}

######################################################################
# writes expression dataset to disk
# it uses hash keys for the row and column indexes... 
# transformations or subselections should delete the appropriate key
# for the respective column or row, so that the matrix also get 
# reduced in size
######################################################################
sub write_dataset {
  my $src_core_epc = shift;	# TODO: write_dataset is always called from source components
  my ($dataset) = @_;
  local ( *COLUMNS, *ROWS, *MATRIX );
  my (%seen);
  my ($row) = 0;

  my ($folder) = $EP::Config::h->{EPNG_USRDATA_PATH} . "/" . $dataset->{folder};
  my ($filename) = $dataset->{filename};

  # remove session id only if user is allowed to have non session based data
  # otherwise data will be linked to session id and this should also be reflected in filename
  if ( EP::Common::DB::session_data_only ( $dataset->{username} ) == 0 ) {
    delete $dataset->{session};
  } else {
    $filename = "$dataset->{session}_$filename";
    $dataset->{filename} = $filename;
  }

  warn "No folder name defined" and return if $folder =~ /^\s*$/;
  warn "No dataset filename defined" and return if $filename =~ /^\s*$/;

  open (COLUMNS, ">$folder/$filename.columns")
    or die "Couldn't open $folder/$filename.columns, $!";
  open (ROWS, ">$folder/$filename.rows") 
    or die "Couldn't open $folder/$filename.rows, $!";
#  open (MATRIX, ">$folder/$filename") 
#    or die "Couldn't open $folder/$filename, $!";

  #not used yet.... in the future to be used for mapping the user specified headers to common id's
  my $mapping;
  my @row_keys = keys %{$dataset->{row}};
  my @row_annot_names = $dataset->{row}{$row_keys[0]}{full_annot}->Keys;
  print ROWS "ID\t", join ( "\t", @row_annot_names ), "\n";

  my @col_keys = keys %{$dataset->{column}};
  my @col_annot_names = $dataset->{column}{$col_keys[0]}{full_annot}->Keys;
  print COLUMNS "ID\t", join ( "\t", @col_annot_names ), "\n";

  foreach my $row_id ( sort { $a <=> $b } keys %{ $dataset->{row} } ) {
    my ($col) = 0;
#    my (@matrix);

    my $row_header = $dataset->{row}{$row_id}{header};
    my ($row_annot) = $dataset->{row}{$row_id}{annot};

    print ROWS "$row\t", join ( "\t", $dataset->{row}{$row_id}{full_annot}->Values ), "\n";

    foreach my $col_id ( sort { $a <=> $b } keys %{ $dataset->{column} } ) {
      if ( !$seen{$col_id}++ ) {
	print COLUMNS "$col\t", join ( "\t", $dataset->{column}{$col_id}{full_annot}->Values ), "\n";
      }
#      push @matrix, ${ $dataset->{matrix} }[$row_id][$col_id];
      $col++;
    }
#    print MATRIX join( "\t", @matrix ), "\n";
    $row++;

    $src_core_epc->session_status ( "Writing row $row" ) if $row % 5000 == 0;
  }
  close (COLUMNS);
  close (ROWS);
#  close (MATRIX);

  $src_core_epc->session_status ( "Writing binary data ..." );

  # create the binary later used for clustering and such
#  write_binary ( $dataset, "$folder/$filename.bin", $src_core_epc );
#  write_binary_transpose ( $dataset, "$folder/$filename.transpose.bin", $src_core_epc );

#  $dataset->{matrix}->inplace->setbadtonan();
  my $hdr = writeflex ( "$folder/$filename.bin",
		       long ( $dataset->{matrix}->dim(1) ),
		       long ( $dataset->{matrix}->dim(0) ),
		       float ( $dataset->{matrix} ) );
  writeflexhdr ( "$folder/$filename.bin", $hdr );

#  $dataset->{matrix}->inplace->setbadtonan();
  $hdr = writeflex ( "$folder/$filename.transpose.bin",
		     long ( $dataset->{matrix}->dim(0) ),
		     long ( $dataset->{matrix}->dim(1) ),
		     float ( transpose ( $dataset->{matrix} ) ) );
  writeflexhdr ( "$folder/$filename.transpose.bin", $hdr );

  warn "[EP CORE] Successfully written expression dataset $filename to folder $folder"
    if DEBUG;

  return 1;
}

######################################################################
# create a binary file of the matrix ... used later on for clustering 
# and such things
######################################################################
sub write_binary {
  my ($dataset, $file, $src_core_epc) = @_;
  local(*BIN);

  my $nr_rows    = scalar ( keys %{ $dataset->{row} } );
  my $nr_columns = scalar ( keys %{ $dataset->{column} } );

  open (BIN, ">$file") or die "Couldn't open file $file, $!";
  print BIN pack("ii", $nr_rows, $nr_columns);

  # put some routine for dealing with na's....
  # for now don't do anything with na's...

  my $row = 0;
  foreach my $row ( sort { $a <=> $b } keys %{ $dataset->{row} } ) {
    foreach my $column ( sort { $a <=> $b } keys %{ $dataset->{column} } ) {
      if ( $dataset->{matrix}[$row][$column] eq "NA" ) {
	print BIN pack ( "C*", 0x00, 0x00, 0xc0, 0xff ); # 0000 C0FF is NaN in R <- empirically deduced. need proof.
      } else {
	print BIN pack ( "f*", $dataset->{matrix}[$row][$column] );
      }
    }
    $row++;
    $src_core_epc->session_status ( "Writing binary row $row") if $row % 500 == 0;
  }
  close BIN;
}

######################################################################
# create a binary file of the matrix transpose ...  used later on for
# bi-clustering
######################################################################
sub write_binary_transpose {
  my ($dataset, $file, $src_core_epc) = @_;
  local(*BIN);

  my $nr_rows    = scalar ( keys %{ $dataset->{row} } );
  my $nr_columns = scalar ( keys %{ $dataset->{column} } );

  open (BIN, ">$file") or die "[EP_Core] Couldn't open file $file, $!";
  print BIN pack("ii", $nr_columns, $nr_rows);

  # put some routine for dealing with na's....
  # for now don't do anything with na's...

  my $col = 0;

  foreach my $column ( sort { $a <=> $b } keys %{ $dataset->{column} } ) {
    foreach my $row ( sort { $a <=> $b } keys %{ $dataset->{row} } ) {
      if ( $dataset->{matrix}[$row][$column] eq "NA" ) {
	print BIN pack ( "C*", 0x00, 0x00, 0xc0, 0xff ); # 0000 C0FF is NaN in R <- empirically deduced. need proof.
      } else {
	print BIN pack ( "f*", $dataset->{matrix}[$row][$column] );
      }
    }
    $col++;
    $src_core_epc->session_status ( "Writing bin. transpose column $col") if $col % 500 == 0;
  }
  close BIN;
}

sub read_dataset {
  my ($dataset) = @_;
  local( *COLUMNS, *ROWS, *MATRIX );

  my ($folder) = $EP::Config::h->{EPNG_USRDATA_PATH} . "/" . $dataset->{folder};
  my ($filename) = $dataset->{filename};

  print STDERR "[EP_Core] No folder name defined\n" and return if $folder =~ /^\s*$/;
  print STDERR "[EP_Core] No dataset filename defined\n" and return if $filename =~ /^\s*$/;

  #read the row identifiers and annotations
  open (ROWS, "$folder/$filename.rows")
    or print STDERR "Couldn't open $filename.rows, $!\n" and die;

  chomp (my $row_annot_header = <ROWS>);
  my @row_annot_names = split "\t", $row_annot_header;
  shift @row_annot_names;	# shift because the first item there is "ID"

  while (<ROWS>) {
    chomp $_;
    my ($row_id, @row_annot) = split /\t/, $_;

    my $row_annotation = {};
    $row_annotation->{$row_annot_names[$_]} = $row_annot[$_] foreach 0 .. $#row_annot_names;

    $dataset->{row}{$row_id} = { header => $row_id,
				 mappped_row_header => "",
				 annot => \@row_annot,
				 full_annot => $row_annotation
			       };
  }
  close ROWS;

  #read the column identifiers and annotations
  open (COLUMNS, "$folder/$filename.columns")
    or print STDERR "Couldn't open $filename.columns, $!\n" and die;

  chomp (my $col_annot_header = <COLUMNS>);
  my @col_annot_names = split "\t", $col_annot_header;
  shift @col_annot_names;	# shift because the first item there is "ID"

  while (<COLUMNS>) {
    chomp $_; 
    my ($col_id, @col_annot) = split /\t/, $_;

    my $col_annotation = {};
    $col_annotation->{$col_annot_names[$_]} = $col_annot[$_] foreach 0 .. $#col_annot_names;

    $dataset->{column}{$col_id} = { header => $col_id,
				    annot => \@col_annot,
				    full_annot => $col_annotation
				  };
  }
  close COLUMNS;

  my ($rows, $cols);
  ( $rows, $cols, $dataset->{matrix} ) = readflex ( "$folder/$filename.bin" );

  my @dims = $dataset->{matrix}->dims();
  die "Problem with reading in PDL matrix from $folder/$filename.bin" if $rows != $dims[1] or $cols != $dims[0];

  warn "Read " . $dataset->{matrix}->info() if DEBUG;
  $dataset->{matrix}->inplace->setnantobad;
  $dataset->{matrix}->badflag(1);

  #add some extra stats to object
  $dataset->{binary} = "$filename.bin" if -f "$folder/$filename.bin";
  $dataset->{row_count} = scalar( keys %{ $dataset->{row} } );
  $dataset->{column_count} = scalar( keys %{ $dataset->{column} } );
  $dataset->{stats} = [$dataset->{matrix}->stats()];
}

######################################################################
# tries to recognize the type of data (i.e. determine delimiters)
######################################################################
sub identify_file {
  my ( $data, $query ) = @_;
  my $filetype = $query->param ( "filetype" );

  if ( $filetype eq "XLS" ) {
    return ( "TAB", qr /\t/ ) if parse_excel_files ( $data, $query );
    die "Not an Excel file!";
  }

  my $file_delim = { TAB       => qr /\t/,
		     VWS       => qr /\s+/,
		     SPACE     => qr / /,
		     CUSTDELIM => $query->param ( "cust_delim" )
		   };

  # if we are *given* the filetype, just go with it...

  # TODO: when I write a function to do -B with strings, I'll do a test here.
  # Now: if you upload an Excel file and want to use it as TAB-delimited, you get a mess...
  if ( not $filetype eq "AUTO" ) {

    die "No delimiter provided for filetype $filetype!" if not exists $file_delim->{$filetype};
    return ( $filetype, $file_delim->{$filetype} );
  } else {
    # try to detect Excel first...
    if ( parse_excel_files ( $data, $query ) ) {
      warn "Automatically detected Excel!" if DEBUG;
      return ( "TAB", qr /\t/ );
    }

    # try to do our usual text detection (NB: on the main data part only, assume delimiter same for others)
    foreach my $delim ( qw ( TAB VWS SPACE ) ) {
      my $count = 0;

      open ID_DATA, "head -n 50 $data->{data} | grep -v --regexp='^\$' |";
      my @id_data = <ID_DATA>;
      close ID_DATA;

      # process only top 100 (or all if data is smaller) rows of the data
      foreach my $i ( 0 .. $#id_data - 1 ) {
	my $nr = 0;
	my $nr2 = 0;
	while ( $id_data[$i]   =~ /$file_delim->{$delim}/g ) { $nr++ };
	while ( $id_data[$i+1] =~ /$file_delim->{$delim}/g ) { $nr2++ };
	
	$count++ if $nr == $nr2 and $nr > 1; # count how many times this line and the following one contains same number
                                             # of delimiters
      }

      if ( $count == $#id_data ) {
	return ( $delim, $file_delim->{$delim} );
      }
    }
  }
}

sub dataparts_txt2rows {
  my ( $data ) = @_;
  # split the data, row_annot and col_annot into rows
  foreach my $part ( "data", "row_annot", "column_annot" ) {
    next if not defined $data->{$part};
    my @rows = split /\r\n|\r|\n/, $data->{$part} if defined $data->{$part};
    undef $data->{$part};
    delete $data->{$part};
    push @{ $data->{$part} }, @rows;
  }
}

# take data parts, write to a temp file, check if binary and then xls2csv
sub parse_excel_files {
  my ( $data, $query ) = @_;

  foreach my $part ( "data", "row_annot", "column_annot" ) {
    next if not defined $data->{$part};
    my $tmp = new File::Temp ( UNLINK => 0 );

    my $out = system_call_with_output ( "xls2csv -c'	' 2>&1 $data->{$part}>$tmp" );
    if ( $out =~ /Error/ or defined EP::Common::Error->prior() and EP::Common::Error->prior()->value() == SYS_CALL_WITH_NONZERO_STATUS ) {
      warn "Found a problem when converting (possibly) Excel file $data->{$part}" if DEBUG;
      unlink $tmp;
      return 0;
    }

    warn "Replacing converted $data->{$part} with $tmp" if DEBUG;

    unlink $data->{$part};
    $data->{$part} = $tmp;
  }

  return 1;
}

1;
